---
title: "Tidy Tuesday #3: Global Mortality"
author: "Thomas John Flaherty"
output:
flexdashboard::flex_dashboard:
orientation: rows
social: menu
theme: lumen
source_code: embed
---
```{r setup, message=F}
remove(list = ls(all.names = TRUE))
detachAllPackages <- function() {
basic.packages.blank <- c("stats","graphics","grDevices","utils","datasets","methods","base")
basic.packages <- paste("package:", basic.packages.blank, sep = "")
package.list <- search()[ifelse(unlist(gregexpr("package:", search())) == 1,TRUE,FALSE)]
package.list <- setdiff(package.list, basic.packages)
if (length(package.list) > 0) for (package in package.list) {
detach(package, character.only = TRUE)}}
detachAllPackages()
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE, dpi = 144, fig.align = "center")
if (!require(pacman)) {
install.packages("pacman")
require(pacman)
}
p_load(knitr, httr, noncensus, readxl, flexdashboard, viridis, crosstalk, DT, raster, tidyverse)
p_load_gh("jbkunst/highcharter")
color_from_middle <- function (data, color1,color2)
{
max_val=max(abs(data))
JS(sprintf("isNaN(parseFloat(value)) || value < 0 ? 'linear-gradient(90deg, transparent, transparent ' + (50 + value/%s * 50) + '%%, %s ' + (50 + value/%s * 50) + '%%,%s 50%%,transparent 50%%)': 'linear-gradient(90deg, transparent, transparent 50%%, %s 50%%, %s ' + (50 + value/%s * 50) + '%%, transparent ' + (50 + value/%s * 50) + '%%)'",
max_val,color2,max_val,color2,color1,color1,max_val,max_val))
}
```
```{r}
# path <- "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/global_mortality.xlsx"
#
# try(GET(path, write_disk(tf <- tempfile(fileext = ".xlsx"))), silent = T)
path <- "~/Documents/GitHub/tidytuesday/data/2018-04-16/global_mortality.xlsx"
dat <- read_excel(path) %>%
mutate_if(is.numeric,
funs(if_else(is.na(.), 0, .))) %>%
group_by(country) %>%
select(-3) %>%
summarise_if(is.numeric,
funs(round(lm(. ~ c(1:27))$coeff[[2]], 3))) %>%
gather(Stat, Value, -country) %>%
mutate(Continent = ccodes()[match(country, ccodes()$NAME), 9],
Stat = gsub(".[[:punct:]]", "", Stat)) %>%
mutate_if(is.character, as.factor) %>%
select(1,2,4,3) %>%
na.omit() %>%
droplevels() %>%
arrange(desc(Value)) %>%
{.}
#unlink(tf)
shared_dat <- SharedData$new(dat)
sd_df <- SharedData$new(dat, group = shared_dat$groupName())
```
Inputs {.sidebar}
-------------------------------------
Here's some really cool text where I talk about how I found the slope for each stat by using a time series linear regression in a `summarize_if()`. It's seriously super baller.
Now on to the data filtering! Nice!
```{r}
filter_select("Stat", "Mortality Statistic:", sd_df, ~Stat)
filter_checkbox("Continent", "Continent:", sd_df, ~Continent)
filter_slider("Value", "Overall Change:", sd_df, ~Value)
```
##
###
```{r}
datatable(sd_df,
colnames = c("Country", "Mortality Statistic", "Continent", "Overall Change"),
extensions = c('Scroller','Buttons'),
plugins = 'natural',
options = list(scrollY = 300,
scroller = T,
dom = 'Bfrtip',
buttons = c('colvis', 'copy', 'csv', 'excel', 'pdf', 'print'),
columnDefs = list(list(className = 'dt-center', type = 'natural'))),
rownames = F,
fillContainer = T,
class = 'cell-border stripe') %>%
formatStyle("Value",
background = color_from_middle(sd_df$data()$Value, 'lightblue', 'lightblue'),
backgroundSize = '95% 50%',
backgroundRepeat = 'no-repeat',
backgroundPosition = 'center')
```